home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 22
/
Cream of the Crop 22.iso
/
program
/
ctlib100.zip
/
INSTALL.LZH
/
BPTREES1.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-10-12
|
4KB
|
156 lines
{**************************************************************************}
{* BitSoft Development, L.L.C. *}
{* Copyright (C) 1995, 1996 BitSoft Development, L.L.C. *}
{* All rights reserved. *}
{* Containers Library demo *}
{**************************************************************************}
program BpTrees1;
{$X+}
{ Sample program for creating a B+ tree. }
uses Objects, Containr, ctBpTree,
{$ifdef Windows}
WinCtr;
{$else}
Crt;
{$endif}
type
PContact = ^TContact;
TContact = record
FirstName : string[15];
LastName : string[20];
Phone : string[18];
Company : string [25];
end; { TContact }
type
PContactList = ^TContactList;
TContactList = object(TBPlusTree)
function KeyOf(Item : Pointer) : Pointer; virtual;
end; { TContactList }
function TContactList.KeyOf(Item : Pointer) : Pointer;
begin
KeyOf := @PContact(Item)^.LastName;
end;
procedure SetContactValues(ALastName, AFirstName, APhone,
ACompany : string; var ContactRec : TContact);
begin
with ContactRec do
begin
FirstName := AFirstName;
LastName := ALastName;
Phone := APhone;
Company := ACompany;
end; { with }
end;
procedure DisplayContacts(ContactList : PGraph);
procedure PrintInfo (Item : Pointer); far;
begin
with PContact(Item)^ do
writeln(LastName, '':15 - Length(LastName),
FirstName, '':15 - Length(FirstName),
Phone, '':20 - Length(Phone),
Company, '':20 - Length(Company));
end;
begin
ContactList^.ForEach(@PrintInfo);
end;
procedure DisplayFirst(ContactList : PGraph);
var
Item : Pointer;
begin
Item := ContactList^.First;
Writeln('First item:');
with PContact(Item)^ do
writeln(LastName, '':15 - Length(LastName),
FirstName, '':15 - Length(FirstName),
Phone, '':20 - Length(Phone),
Company, '':20 - Length(Company));
ContactList^.DoneItem(Item); { not required }
end;
procedure DisplayLast(ContactList : PGraph);
var
Item : Pointer;
begin
Item := ContactList^.Last;
Writeln('Last item:');
with PContact(Item)^ do
writeln(LastName, '':15 - Length(LastName),
FirstName, '':15 - Length(FirstName),
Phone, '':20 - Length(Phone),
Company, '':20 - Length(Company));
ContactList^.DoneItem(Item); { not required }
end;
procedure FindLastName(ContactList : PGraph; LastName : string);
var
Item : Pointer;
begin
Item := ContactList^.KeyFirst(@LastName);
Writeln('Item found with last name ''', LastName, ''':');
with PContact(Item)^ do
writeln(LastName, '':15 - Length(LastName),
FirstName, '':15 - Length(FirstName),
Phone, '':20 - Length(Phone),
Company, '':20 - Length(Company));
ContactList^.DoneItem(Item); { not required }
end;
var
ContactList : PContactList;
Contact : TContact;
Stream : PBufStream;
begin
ClrScr;
{ Create the stream }
Stream := New(PBufStream, Init('btrees.dat', stCreate, 1024));
{ Create the B tree }
ContactList := New(PContactList, Init(2, 3, SizeOf(TContact),
20, Stream, 5, 2));
{ Insert the items in the B tree }
with ContactList^ do
begin
SetContactValues('Lewis', 'Carl', '(506) 83-780', 'Running, Corp.',
Contact);
Insert(@Contact);
SetContactValues('Benton', 'Michael', '(403) 33-973', 'ER, Inc.',
Contact);
Insert(@Contact);
SetContactValues('Wagner', 'Robert', '(906) 11-230', 'Symphony, Ltd.',
Contact);
Insert(@Contact);
SetContactValues('Smith', 'John', '(656) 75-843', 'InterComm, Corp.',
Contact);
Insert(@Contact);
end; { with }
DisplayContacts(ContactList);
Writeln;
DisplayFirst(ContactList);
Writeln;
DisplayLast(ContactList);
Writeln;
FindLastName(ContactList, 'Wagner');
{ Dispose of the B tree }
Dispose(ContactList, Done);
{ Dispose of the stream }
Dispose(Stream, Done);
end.